home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / TAN_SND.ARJ / SONG.PAS < prev   
Pascal/Delphi Source File  |  1991-07-28  |  2KB  |  92 lines
  1. { SONG.PAS - Demo of music and drum routines for Tandy 1000 and/or PCJr }
  2.  
  3. uses noiz,drums;
  4.  
  5. procedure check_key(var ch: char);
  6. begin
  7.   if keyhit then
  8.   begin
  9.     ch:=upcase(fkey);
  10.     case ch of
  11.       '1': roto1(10,1);
  12.       '2': roto2(6,10);
  13.       '3': roto5(8,0,5);
  14.       '4': snare(10,2);
  15.       '5': begin
  16.              snare(4,8); snare(8,2); snare(4,4);
  17.            end;
  18.       'Q',
  19.       #27: begin
  20.              up(1,19,1); sound(e1); wait(50);
  21.              chord(e3,b3,fs4,32,17);
  22.              sound(e2); echo(80,long); writeln;
  23.              quiet; halt;
  24.            end;
  25.       'F': begin
  26.              writeln; quiet; halt;
  27.            end;
  28.     end;
  29.   end;
  30. end;
  31.  
  32. procedure beat;
  33. var
  34.   i,j: integer;
  35.   ch: char;
  36. begin
  37.   i:=0; j:=0;
  38.   repeat
  39.     check_key(ch);
  40.     inc(i); inc(j);
  41.     case i of
  42.       10: begin
  43.             quiet;
  44.             roto5(8,20,2); sims(10,1);snare(8,2); tom(4,4); lowtom(8,2);
  45.             i:=0; j:=0;
  46.           end;
  47.     end;
  48.     case j of
  49.       1: chord(d4,fs4,b5,1,14);
  50.       2: chord(c4,g4,d4,1,14);
  51.       3: chord(a4,cs4,fs4,1,14);
  52.       4: chord(d4,a4,d5,1,14);
  53.       5: begin
  54.            snare(2,5); lowtom(1,10);
  55.            roto1(2,2); roto2(2,20);
  56.            j:=0;
  57.          end;
  58.     end;
  59.     sound(a2); bass(1,10);
  60.     sound(b2); snare(1,10);
  61.     sound(g2); lowtom(2,5);
  62.     sound(e2); snare(1,10);
  63.   until true = false;
  64. end;
  65.  
  66. procedure main;
  67. const
  68.   ray: array[1..8] of string[80] =
  69.        ('1)   Roto 1',
  70.         '2)   Roto 2',
  71.         '3)   Roto 5',
  72.         '4)   Snare roll',
  73.         '5)   Snare lick',
  74.         'Q)   Quit with Ending',
  75.         'ESC) Quit with Ending',
  76.         'F)   Halt with no Ending');
  77.  
  78. var
  79.   i: integer;
  80.  
  81. begin
  82.   writeln(#10'       -  Menu  -'#10);
  83.   for i:=1 to 8 do writeln('    '+ray[i]);
  84.   write(#10' Command [1,2,3,4,5,Q,F]: ');
  85.   beat;
  86. end;
  87.  
  88. begin
  89.   drums.inturbo:=false; noiz.inturbo:=false;
  90.   main;
  91. end.
  92.